home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / scrbump.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  2KB  |  81 lines
  1.  
  2. program text_sinus_scroll;
  3. { smooth sinus-scroll in textmode, by Bas van Gaalen, Holland, PD }
  4. uses crt;
  5. const sspd = -1; samp = 75; sofs = 250; slen = 255; vseg : word = $b800;
  6.   txt : string = 'Another way to scroll... :-)     ';
  7. var stab : array[0..255] of word; fseg,fofs : word;
  8.  
  9. procedure getfont8x8; assembler; asm
  10.   mov ax,1130h; mov bh,1; int 10h; mov fseg,es; mov fofs,bp; end;
  11.  
  12. procedure setimage(ch : char; var data);
  13. var offset : word;
  14. begin
  15.   offset := ord(ch)*32;
  16.   inline($fa);
  17.   portw[$03c4] := $0402;
  18.   portw[$03c4] := $0704;
  19.   portw[$03ce] := $0204;
  20.   portw[$03ce] := $0005;
  21.   portw[$03ce] := $0006;
  22.   move(data,ptr($a000,offset)^,8);
  23.   portw[$03c4] := $0302;
  24.   portw[$03c4] := $0304;
  25.   portw[$03ce] := $0004;
  26.   portw[$03ce] := $1005;
  27.   portw[$03ce] := $0E06;
  28.   inline($fb);
  29. end;
  30.  
  31. procedure initialize;
  32. var charset : array[0..7] of byte; i : byte;
  33. begin
  34.   if lastmode = 7 then vseg := $b000;
  35.   textmode(co80+font8x8);
  36.   textcolor(white); clrscr;
  37.   writeln; writeln('In case you don''t believe it: this is textmode...');
  38.   gotoxy(1,1); mem[$b800:1] := 0;
  39.   for i := 0 to 7 do begin
  40.     fillchar(charset,sizeof(charset),0);
  41.     charset[i] := 3;
  42.     setimage(chr(128+i),charset);
  43.   end;
  44. end;
  45.  
  46. procedure generatetab; var i : byte; begin
  47.   for i := 0 to 255 do stab[i] := round(sin(4*pi*i/slen)*samp)+sofs; end;
  48.  
  49. procedure scroll;
  50. var postab : array[0..79,0..7] of word; bitmap : array[0..79,0..7] of byte;
  51.   sctr,tctr,curchar,l,b,x,y : byte;
  52. begin
  53.   fillchar(postab,sizeof(postab),0);
  54.   fillchar(bitmap,sizeof(bitmap),0);
  55.   sctr := 0; tctr := 1;
  56.   repeat
  57.     curchar := ord(txt[tctr]); tctr := 1+tctr mod length(txt);
  58.     for b := 0 to 7 do begin
  59.       move(bitmap[1,0],bitmap[0,0],sizeof(bitmap));
  60.       for l := 0 to 7 do
  61.         if ((mem[fseg:fofs+8*curchar+l] shl b) and 128) <> 0 then
  62.           bitmap[79,l] := 1 else bitmap[x,y] := 0;
  63.       while (port[$3da] and 8) <> 0 do; while (port[$3da] and 8) = 0 do;
  64.       for x := 0 to 79 do for y := 0 to 7 do mem[vseg:postab[x,y]] := 32;
  65.       for x := 0 to 79 do for y := 0 to 7 do begin
  66.         postab[x,y] := (y+(stab[(sctr+x) mod slen] div 8))*160+x+x;
  67.         if bitmap[x,y] = 1 then mem[vseg:postab[x,y]] := 128+stab[(sctr+x) mod slen] mod 8;
  68.       end;
  69.       sctr := (sctr+sspd) mod slen;
  70.     end;
  71.   until keypressed;
  72. end;
  73.  
  74. begin
  75.   initialize;
  76.   getfont8x8;
  77.   generatetab;
  78.   scroll;
  79.   textmode(lastmode);
  80. end.
  81.